The Original Shareware 1.1/The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso/19/madtrb11.zip/SHEET.PAS

Pascal/Delphi Source File | 1985-11-28 | 24KB | 1,109 lines

program sheet;    { for MS include (input,output) }

{ for MS replace # with chr(...) around the number  below }
{         WILD BLUE SKY PLANNING AREA                        }
{                                                               }
{   --Use a sparse matrix for the sheet var..NEW as           }
{     needed                                                    }
{                                                               }
{                                                               }
{                                                               }
{                                                               }
{                                                               }
{                                                               }
{                                                               }


const
  max_wide = 25;
  max_long = 50;
  maxfields = 40;     { for now }
  ul_c      = #218;
  ll_c         = #192;
  ur_c         = #191;
  lr_c         = #217;
  v_c          = #179;
  h_c          = #196;
  maxitems     = 10;    { for menugen }
  maxwindows   = 50;
  maxevents    = 50;
  current_attribute = #7;
  bchk         = #220;
  scale_factor = 65;

type
  lst  = string[80];

  lst_p  = ^lst;

  dte = record
    year : integer;
    month : integer;
    day : integer;
   end;  { dte }



   duo = array[0..1] of integer;
   quad = array[0..3] of integer;
   position = duo;
   line_type = quad;


   range_type=record
      top : duo;
      bottom : duo;
    end;  { rnage_type }


  time_type = record
    hour : byte;
    minute : byte;
    second : byte;
   end;   { time_type }

  field = array[0..1] of lst;  { 1 for label, one for data }


  window_p    = ^window_type;

  event_p =   ^event_record;

{
  textstring_type = record
     the_text : array[0..1000] of char;
     strpos   : integer;
     len      : integer;
    end;
}

 numstr = string[8];

 sheet_type = array[0..max_wide,0..max_long] of numstr;

 sheet_record_type = record
     active_cell : duo;
     cell_pos    : integer;
     offset      : duo;
    end;


 window_type = record
     ulLR     : QUAD;
     job      : integer;
    end;      { window_type }


  setofchar   = set of char;

  regpack = record
     ax,bx,cx,dx,bp,di,si,ds,es,flags  : integer;
  end;



  event_record = record
       active_window : window_p;
       keypress      : boolean;
       key           : char;
       cursor_where  : position;
       sysreq        : byte;
     end;   { event_record }


  system_status_type = record
       active_window : byte;
       drives_on     : byte;  { bit coded..1 on is A:, 2 on is B:, etc }
       time          : time_type;
       date          : dte;
       cursor_where  : position;
       window_move : boolean;
     end;     { system_status_type }



  screen_position_pair_type = (char_byte, attr_byte);

  imagetype = array[1..25,1..80,char_byte..attr_byte] of char;


  image_p     = ^imagetype;

  point_type  =  (r, d, o);



var
  point_mode           : point_type;
  range                : range_type;
  rp_mode              : boolean;
  ch , up, down, left, right, retrn, escape, home,
  endd, pgup, pgdn,f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,
  f11,f12,f13,f14,f15  :  char;
  i                    : integer;
  wp                   : array[0..maxwindows] of window_p;   { window pointer }
  wp_index             : integer;
  control_set          : setofchar;
  event                : event_record;
  system_status        : system_status_type;
  counter, max         : integer;
  system_okset         : setofchar;
  crtmode,page,width   : byte;
  monobuffer           : imagetype absolute $B000:$0000;
  colorbuffer          : imagetype absolute $B800:$0000;
  buffer               : imagetype;
  screen_stack         : array[0..maxwindows] of image_p;
  sheet                : sheet_type;
  sheet_record         : sheet_record_type;
  sheet_corn, graph_corn : quad;
  rl_ar    :  array[0..12] of real;
  ar_sz    :  integer;
  scale    : real;

{$Isheetlib.inc}


function str2real(str:numstr):real;

var
  i,j : integer;
  tempr : real;


function pwr10(exp:integer):real;

var
  i : integer;
  tempr : real;

begin
  tempr := 1;
  for i := 1 to exp do tempr := tempr*10;
  pwr10 := tempr;
end;


begin { str2real}
  tempr := 0;
  j := 1;
  for i := length(str) downto 1 do
    begin
      if str[i] in ['1'..'9']
         then
           begin
             tempr := tempr + ( (integer(str[i])-48) )*pwr10(j);
             j := j + 1;
           end;
    end;
  str2real := tempr;
end; { str2real }








procedure val_shell(st : numstr;var v :real; var cd :integer);

var
  i : integer;
  locstr : numstr;
  ch     : char;

begin
  locstr := '';
  for i := 1 to length(st) do if (st[i] in ['0'..'9'])
                then locstr := locstr+st[i];

{----------}
  gotoxy(1,15);
  write('locstr ',locstr);
{-----}



  val(locstr,v,cd);
end;






procedure getxy(sh_co:duo;var xy:duo);   { returns phyciscal coords of sheet}
                                 { location}

begin
  xy[0] := 8*(sh_co[0]-1)+sheet_corn[0]+1;
  xy[1] := sh_co[1]+sheet_corn[1]+1;
end;


procedure getshco(xy:duo;var shco:duo);   { returns sheet coords of phys xy }
                                { location }

begin
  shco[0] := round((xy[0]-sheet_corn[0]-1)/8);
  shco[1] := xy[1]-sheet_corn[1]-1;
end;




procedure gettime(var time : time_type);

var
  local_time : time_type;
  recpack    : regpack;

begin
  with recpack do
   begin
     ax := $2c shl 8;   { time of day request }
   end;
   msdos(recpack);      { dos call }
 with recpack do
  begin
   local_time.second := dx shr 8;
   local_time.minute := cx mod 256;
   local_time.hour   := cx shr 8;
   with local_time do
    if hour > 12 then hour := hour - 12;

  end;

   time := local_time;
end;  { gettime }




procedure getdate(var local_date :dte);

var
  recpack    : regpack;

begin
  with recpack do
   begin
     ax := $2a shl 8;   { date request }
   end;
   msdos(recpack);      { dos call }
  with recpack do
  begin
   local_date.year  := cx;
   local_date.day   := dx mod 256;
   local_date.month := dx shr 8;
  end;
end;  { getdate }



procedure draw_window(window_pointer : window_p);

var
  x, y : integer;

begin
  with Window_pointer^ do
begin
      for y := ullr[1] to ullr[3] do
        for x := ullr[0] to ullr[2] do
            putchar(x,y,' ');

     drawbox(ullr[0],ullr[1], (ullr[2] - ullr[0]), (ullr[3] - ullr[1]) );

 end;
 end;










procedure get_event(var event : event_record);


begin

{event.keypress  := KeyPressed;}

{ intrinisc boolean }

event.key := getchar(system_okset,false);

{-------------}

{ write('event.key, ord(event.key) ',event.key,ord(event.key)); }

if event.key = f1 then event.sysreq := 5 else    { open window }
  if event.key = f2 then event.sysreq := 6 else
    if event.key = f3 then event.sysreq := 7 else      { cut window }
      if event.key = f5 then event.sysreq := 9;     { move window around }


end;






procedure window_manage(var event : event_record);

var
  corners : quad;
  columns : integer;
  ch      : char;
  start, stop : byte;
  temp_window: window_type;   { temporary window }
  temp_buf   : imagetype;
  i          : integer;


begin
if event.sysreq = 5 then    { make window }

begin
 wp_index := wp_index + 1;    { overall layer counter }

 { save current screen }
 new(screen_stack[wp_index]);
 get_screen(buffer);
 screen_stack[wp_index]^ := buffer;

 { make new window }
 new(wp[wp_index]);

 corners[0]  := 40;
 corners[1]  := 12;

 gotoxy(corners[0],corners[1]);
 set_cursor;

 { establish NW corner of window }
repeat
   ch := getchar([retrn, right, down,left, up,home], false);
   if (ch = left) then
        corners[0] := corners[0] - 1;

   if (ch = up) then corners[1] := corners[1] - 1;
   if (ch = right) then
        corners[0] := corners[0] + 1;

   if (ch = down) then corners[1] := corners[1] + 1;
   if (ch = home) then
     begin
        corners[0] := corners[0] - 1;
        corners[1] := corners[1] - 1;
     end;

   GotoXY(corners[0],corners[1]);
 until ( ch = retrn);


 corners[2] := corners[0];
 corners[3] := corners[1];


   { get SE corner from user  -- keep showing box }
 repeat
   ch := getchar([retrn, right, down,home,endd,pgup,pgdn], false);
   if (ch = right) then
        corners[2] := corners[2] + 1;

   if (ch = down) then corners[3] := corners[3] + 1;
   if (ch = home) then
     begin
        corners[2] := corners[2] - 1;
        corners[3] := corners[3] - 1;
     end;

   if (ch = endd) then
     begin
        corners[2] := corners[2] - 1;
        corners[3] := corners[3] - 1;
     end;

   if (ch = pgup) then
     begin
        corners[2] := corners[2] + 1;
        corners[3] := corners[3] - 1;
     end;

   if (ch = pgdn) then
     begin
        corners[2] := corners[2] + 1;
        corners[3] := corners[3] + 1;
     end;


   wp[wp_index]^.ullr := corners;
   draw_window(wp[wp_index]);
 until ( ch = retrn);


 draw_window(wp[wp_index]);   { will clean inside of box }



 event.cursor_where[0] := corners[0]+1;
 event.cursor_where[1] := corners[1]+1;
     { set things up for action inside the box }


 EVENT.Active_Window := wp[wp_index];

 reset_cursor;


 end
    { if sysreq = 5 }
 else if (event.sysreq = 6) then   { zap window }
  begin
   if (wp_index > 1) then

   begin
     dispose(wp[wp_index]);                { pop window stack }
     if (crtmode = 7) then monobuffer := screen_stack[wp_index]^
         else colorbuffer := screen_stack[wp_index]^;
             { restore previous screen }
     dispose(screen_stack[wp_index]);
     decr(wp_index);
   end
  end  { if sysreq = 6 }

else if (event.sysreq = 7) then   { scroll--top window to bottom }
                                  { of stack, everybody moves up one }

  begin
    temp_buf           := screen_stack[wp_index]^;
    temp_window        := wp[wp_index]^;
               { save top of stacks }
    for i := (wp_index - 1) downto 1 do
     begin
      screen_stack[i + 1]^ := screen_stack[i]^;
      wp[i + 1]^          := wp[i]^;
     end;
        { pop the stacks }

    screen_stack[1]^ := temp_buf;
    wp[1]^          := temp_window;

    for i := 1 to wp_index do
     begin
       draw_window(wp[i]);
     end;

    event.cursor_where[0] := wp[i]^.ullr[0]+1;
    event.cursor_where[1] := wp[i]^.ullr[1]+1;


  end   { = 7 }
 else if (event.sysreq = 8) then    { make window without getting coords }
begin
 wp_index := wp_index + 1;    { overall layer counter }

 { save current screen }
 new(screen_stack[wp_index]);
 get_screen(buffer);
 screen_stack[wp_index]^ := buffer;

 { make new window }
 new(wp[wp_index]);

 wp[wp_index] := event.active_window;  { get coords that are in event_record }

 draw_window(wp[wp_index]);   { will clean inside of box }



 event.cursor_where[0] := corners[0]+1;
 event.cursor_where[1] := corners[1]+1;
     { set things up for action inside the box }


 EVENT.Active_Window := wp[wp_index];


 reset_cursor;


 end
 else if event.sysreq=9 then   { move window around }

 begin
  { get keystroke, move frame }
  repeat
    with wp[wp_index]^ do begin
      ch := getchar([retrn, right, down,left, up,home], false);
      if (ch = left) then
           begin
             decr(ullr[0]); decr(ullr[2]);
           end;

      if (ch = up) then
           begin
             decr(ullr[1]); decr(ullr[3]);
           end;

      if (ch = right) then
           begin
             incr(ullr[0]); incr(ullr[2]);
           end;


      if (ch = down) then
           begin
             incr(ullr[1]); incr(ullr[3]);
           end;

      draw_window(wp[wp_index]);
    end   { with wp[wp_index]^ }
 until (ch=retrn);
    { now clear screen, redraw whole system }
    clrscr;

    for i := 1 to wp_index do
     begin
       draw_window(wp[i]);
     end;

    event.cursor_where[0] := wp[i]^.ullr[0]+1;
    event.cursor_where[1] := wp[i]^.ullr[1]+1;

 end;

event.sysreq := 0;

end; {manage_window...}






procedure manage_system_okset(m_okset : setofchar);

begin end;




procedure update_system_rec(sysrec : system_status_type);


procedure show_status(sysrec : system_status_type);

const
  slash = '/';
  colon = ':';

var
  h,m,s,d,y   : string[4];
  datestr, timestr  : string[12];


begin
  with sysrec do
  begin
    str(date.day,d);
    str(date.month,m);
    str(date.year,y);
    datestr := m + slash+ d + slash + y;
    str(time.second:2,s); if s[1]=' ' then s[1] := '0';
    str(time.minute:2,m); if m[1]=' ' then m[1] := '0';
    str(time.hour:2,h); if h[1]=' ' then h[1] := '0';
    timestr := h + colon + m + colon + s ;
  end;
  drawbox(1,1,10,2);
  putstring(2,2,'        ');
  putstring(2,3,'        ');
  putstring(2,2,datestr);
  putstring(2,3,timestr);

end;



begin   { update_system_rec }
with sysrec do
  begin
      getdate(sysrec.date);
      gettime(sysrec.time);
      show_status(sysrec);

  end;
end;






procedure read_init_file;

var

  quad_file : file of quad;
  the_quad  : quad;   { TYPE QUAD is an array[0..3] of integer }



begin
  assign(quad_file,'config.dat');
  reset(quad_file);


  while not eof(quad_file) do
    begin
      read(quad_file, the_quad);
      event.sysreq := 8;
      event.active_window^.ullr := the_quad;

      window_manage(event);
    end;

end;   { read_init_file }





procedure update_system(var event : event_record;
                        var system_status : system_status_type);

begin
  update_system_rec(system_status);
  gotoxy(event.cursor_where[0],event.cursor_where[1]);
end;  { update_system }









procedure update_sheet_window(var event : event_record);

var
  temp : numstr;


PROCEDURE PUTS(xcoord, ycoord : integer;s :numstr);

var
  i :integer;

begin
  for i := 1 to length(s) do putchar((xcoord + i - 1), ycoord,s[i]);
end;   { PUTS }


PROCEDURE PUTSv(xcoord, ycoord : integer;s :numstr);

var
  i :integer;

begin
  for i := 1 to length(s) do putcharv((xcoord + i - 1), ycoord,s[i]);
end;   { PUTS }




procedure cell_jump(ch : char);


begin
         if (ch = up) then
           begin
             if (sheet_record.active_cell[1]+
                 sheet_record.offset[1]) > 0
                then
                  begin
                    decr(sheet_record.active_cell[1]);
                    sheet_record.cell_pos := 1;
                  end       { if (sheet.. then }
           end         { if ch=up }
        else
         if ((ch = down) or (ch=retrn)) then
           begin
             if (sheet_record.active_cell[1]+
                 sheet_record.offset[1]) < 8
                then
                  begin
                    incr(sheet_record.active_cell[1]);
                    sheet_record.cell_pos := 1;
                  end       { if (sheet.. then }
           end         { if ch=up }
        else
         if (ch = left) then
           begin
             if (sheet_record.active_cell[0]+
                 sheet_record.offset[0]) > 0
                then
                  begin
                    decr(sheet_record.active_cell[0]);
                    sheet_record.cell_pos := 1;
                  end       { if (sheet.. then }
           end         { if ch=left }
        else
         if (ch = right) then
           begin
             if (sheet_record.active_cell[0]+
                 sheet_record.offset[0]) < 7
                then
                  begin
                    incr(sheet_record.active_cell[0]);
                    sheet_record.cell_pos := 1;
                  end       { if (sheet.. then }
           end;         { if ch=right }

end;            { procedure cell_jump}







procedure num_update(ch : char);


begin
  with sheet_record do

       begin
         sheet[active_cell[0],active_cell[1]][cell_pos] := ch;
         { move cursor }
         if cell_pos < 7 then
            begin
              incr(cell_pos);
              incr(event.cursor_where[0]);
            end;
         { rewrite this cell, first blank out }
         puts( (sheet_corn[0]+1+active_cell[0]*8),
                    (sheet_corn[1]+1+active_cell[1]),'       ');
         temp := sheet[active_cell[0],active_cell[1]];
         puts( (sheet_corn[0]+1+active_cell[0]*8),
                    (sheet_corn[1]+1+active_cell[1]), temp);
      end;
end;         { procedure num_update }




procedure rp(ch : char);

{ handles point mode }


begin
  with sheet_record do
     begin

         if ( ((ch = down) or (ch=retrn)) and (point_mode in [o,d]) ) then
           begin
             if (point_mode=o) then point_mode := d;
             if (sheet_record.active_cell[1]+
                 sheet_record.offset[1]) < 8
                then
                  begin
                    incr(sheet_record.active_cell[1]);
                    sheet_record.cell_pos := 1;
                    putsv( (sheet_corn[0]+1+active_cell[0]*8),
                    (sheet_corn[1]+1+active_cell[1]),'       ');

                    putsv( (sheet_corn[0]+1+active_cell[0]*8),
                    (sheet_corn[1]+1+active_cell[1]),
                    sheet[active_cell[0],active_cell[1]]);
                  end       { if (sheet.. then }
           end         { if ch=down,retrn }
        else
         if ( (ch = right) and (point_mode in [o,r]) ) then
           begin
             if (point_mode=o) then point_mode := r;
             if (sheet_record.active_cell[0]+
                 sheet_record.offset[0]) < 7
                then
                  begin
                    incr(sheet_record.active_cell[0]);
                    sheet_record.cell_pos := 1;
                    putsv( (sheet_corn[0]+1+active_cell[0]*8),
                    (sheet_corn[1]+1+active_cell[1]),'       ');

                    putsv( (sheet_corn[0]+1+active_cell[0]*8),
                    (sheet_corn[1]+1+active_cell[1]),
                    sheet[active_cell[0],active_cell[1]]);
                  end       { if (sheet.. then }
           end         { if ch=right }
         else if (ch='.') then
           begin
             point_mode := o;
             rp_mode := false;
             range.bottom[0] := sheet_corn[0]+1+active_cell[0]*8;
             range.bottom[1] := sheet_corn[1]+1+active_cell[1];
           end;


    end; { with sheet_record do }

end;   { rp }



procedure rew_old_range;

var
  i,r,c : integer;
  ch  : char;

begin


  with range do
   begin
     for c := top[0] to bottom[0] do   { x - coordinates }
       for r := top[1] to bottom[1] do   { y - coordinates }
         puts(c,r,sheet[round((c-14)/8),r-3]);
   end;


end;









begin  { update sheet window }



  with event do

   begin

    if (not rp_mode) then with sheet_record do

     begin
      if (key in ['0'..'9']) then num_update(key)
        else if (key in [up,down,left,right,retrn]) then
          cell_jump(key)
          else if (key='.') then
             begin
               { flip the global rp flag }

               rew_old_range;
               rp_mode := true;
               range.top[0] := sheet_corn[0]+1+active_cell[0]*8;
               range.top[1] := sheet_corn[1]+1+active_cell[1];
               { rewrite the old range as normal video }

               temp := sheet[active_cell[0],active_cell[1]];
               putsv( (sheet_corn[0]+1+active_cell[0]*8),
                    (sheet_corn[1]+1+active_cell[1]),
                     sheet[active_cell[0],active_cell[1]]);
             end  { if (key=.. }

     end  { if not rp_mode }
      else
       rp(key); { define range }




   { now get cursor to right place }
    with sheet_record do
      begin
         cursor_where[0] := sheet_corn[0]+active_cell[0]*8
                         +cell_pos;
         cursor_where[1] := sheet_corn[1]+active_cell[1]+ 1;
      end;  { with sheet_record do }

   end;  { with event do }


end;   { update sheet window }





procedure update_graph_window(event:event_record);

var
  temp_duo : duo;
  rl_ar    :  array[0..12] of real;
  dirc     :  point_type; { r,d,o}
  i,j,k,x,y    :  integer;
  min,max, num_bars :real;
  cd       : integer;
  tempstr  : numstr;


{ get numbers from range, convert to reals, store in }
{ array }

begin   { update graph window }
  { make it active window, clear}
     if (scale > 0) then
       for i := 0 to ar_sz do
         for j := 0 to scale_factor do
             putchar( (graph_corn[0]+j+1),(graph_corn[1]+i+1),' ');




  ar_sz := 0;



  with range do
    begin
      if top[0]=bottom[0] then dirc := d else dirc := r;
      getshco(top,temp_duo);
      if dirc = d then ar_sz := bottom[1]-top[1]
          else ar_sz := bottom[0]-top[0];
    end;



    for i := 0 to ar_sz do   { convert strings to reals }
       begin

         if dirc=d then
             begin
                tempstr := sheet[temp_duo[0],temp_duo[1]+i];
                rl_ar[i] := str2real(tempstr);
             end
           else
             begin
                tempstr := sheet[temp_duo[0]+i,temp_duo[1]];
                rl_ar[i] := str2real(tempstr);
             end;
       end;




      min := rl_ar[0]; max := min;
      for i := 1 to ar_sz do
        begin
          if rl_ar[i] < min then min := rl_ar[i];
          if rl_ar[i] > max then max := rl_ar[i];
        end;

      scale := max/scale_factor;



     if (scale > 0) then
       for i := 0 to ar_sz do
         for j := 0 to round(rl_ar[i]/scale) do
             putchar( (graph_corn[0]+j+1),(graph_corn[1]+i+1),bchk);







end;    { update graph window }



procedure initialize;

var
  i,j : integer;


begin
  current_video_state(page,crtmode,width);
  init_var;
  normal; { set video attribute }
  if crtmode = 7 then buffer := monobuffer
      else buffer := colorbuffer;
  clrscr;

  for i := 0 to max_wide do
    for j := 0 to max_long do
      begin
        sheet[i,j] := '        ';
      end;
  system_okset := [#1..#254, up, down, left, right, escape, retrn,f1,f2,f3,f4,
        f5,f6,f7,f8,f9,f10,f11,f12,f13,f14,f15];

  { make sheet window }
  new(wp[wp_index]);  { now wp[0] is the strings }
  wp[wp_index]^.ullr := sheet_corn;
  draw_window(wp[wp_index]);

  { make graph window }
  incr(wp_index);
  new(wp[wp_index]);  { now wp[1] is the graph }
  wp[wp_index]^.ullr := graph_corn;
  draw_window(wp[wp_index]);

  { make sheet window active }
  decr(wp_index);
  with event do
    begin
      for i := 0 to 1 do cursor_where[i] := sheet_corn[i] + 1;
      active_window := wp[wp_index];
    end;

  { initialize verious stuff in sheet record }

  sheet_record.cell_pos := 1;

  for i := 0 to 1 do
    begin
      sheet_record.active_cell[i] := 0;
      sheet_record.offset[i]      := 0;
    end;



 end;  { initialize }






procedure clean_up; begin end;




begin { sheet main loop }
  initialize;
  event.key := #0;
  update_sheet_window(event);


       repeat
          get_event(event);

          update_sheet_window(event);
          update_graph_window(event);
          update_system(event,system_status);
        until (event.key=escape);
   clean_up;
end.